home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
HAMRADIO
/
KAM401.ZIP
/
KAM-IO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-08-25
|
18KB
|
641 lines
{ global declarations }
const
UART_THR = $00; { offset from base of UART Registers for IBM PC }
UART_RBR = $00;
UART_IER = $01;
UART_IIR = $02;
UART_LCR = $03;
UART_MCR = $04;
UART_LSR = $05;
UART_MSR = $06;
I8088_IMR = $21; { port address of the Interrupt Mask Register }
COM1_Base = $03F8; { port addresses for the UART }
COM2_Base = $02F8;
COM1_Irq = 4; { Interrupt line for the UART }
COM2_Irq = 3;
Async_Buffer_Max = $0FFF;
var
OldInterruptSegment,
OldInterruptOffset : integer;
Async_Buffer : Array[0..Async_Buffer_Max] of char;
Async_Open_Flag : Boolean; { true if Open but no Close }
Async_Port : Integer; { current Open port number (1 or 2) }
Async_Base : Integer; { base for current open port }
Async_Irq : Integer; { irq for current open port }
Async_Buffer_Overflow : Boolean; { True if buffer overflow has happened }
Async_Buffer_Used : Integer;
Async_MaxBufferUsed : Integer;
{ Async_Buffer is empty if Head = Tail }
Async_Buffer_Head : Integer; { Locn in Async_Buffer to put next char }
Async_Buffer_Tail : Integer; { Locn in Async_Buffer to get next char }
Async_Buffer_NewTail : Integer;
const
Async_Num_Bauds = 8;
Async_Baud_Table : array [1..Async_Num_Bauds] of record
Baud, Bits : integer
end
= ((Baud:110; Bits:$00),
(Baud:150; Bits:$20),
(Baud:300; Bits:$40),
(Baud:600; Bits:$60),
(Baud:1200; Bits:$80),
(Baud:2400; Bits:$A0),
(Baud:4800; Bits:$C0),
(Baud:9600; Bits:$E0));
{----------------------------------------------------------------------}
{ Issue Interrupt $14 to initialize the UART }
{ See the IBM PC Technical Reference Manual for the format of ComParm }
{----------------------------------------------------------------------}
procedure BIOS_RS232_Init(ComPort, ComParm : Integer);
var
Regs : Registers;
begin
with Regs do
begin
ax := ComParm AND $00FF; { AH=0; AL=ComParm }
dx := ComPort;
Intr($14, Regs)
end
end; { BIOS_RS232_Init }
{----------------------------------------------------------------------}
{ call DOS to set an interrupt vector }
{----------------------------------------------------------------------}
procedure GetInterruptVector(v : integer);
var Regs : Registers;
begin
with Regs do
begin
ax := $3500 + (v AND $00FF);
MsDos(Regs);
OldInterruptSegment := bx;
OldInterruptOffset := es;
end;
end;
procedure DOS_Set_Intrpt(v, s, o : integer);
var
Regs : Registers;
begin
with Regs do
begin
ax := $2500 + (v AND $00FF);
ds := s;
dx := o;
MsDos(Regs)
end
end; { DOS_Set_Intrpt }
procedure RestoreInterruptVector(v : integer);
begin
DOS_Set_Intrpt(v, OldInterruptSegment, OldInterruptOffset);
end;
{----------------------------------------------------------------------}
{ }
{ ASYNCISR.INC - Interrupt Service Routine }
{ Invoked when the UART has received a byte of data from the }
{ communication line }
{ }
{----------------------------------------------------------------------}
procedure Async_Isr;
interrupt;
begin
Inline(
$FB/ { STI }
{ get the incoming character }
{ Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); }
$8B/$16/Async_Base/ { MOV DX,Async_Base }
$EC/ { IN AL,DX }
$8B/$1E/Async_Buffer_Head/ { MOV BX,Async_Buffer_Head }
$88/$87/Async_Buffer/ { MOV Async_Buffer[BX],AL }
{ Async_Buffer_NewHead := Async_Buffer_Head + 1; }
$43/ { INC BX }
{ if Async_Buffer_NewHead > Async_Buffer_Max then
Async_Buffer_NewHead := 0; }
$81/$FB/Async_Buffer_Max/ { CMP BX,Async_Buffer_Max }
$7E/$02/ { JLE L001 }
$33/$DB/ { XOR BX,BX }
{ if Async_Buffer_NewHead = Async_Buffer_Tail then
Async_Buffer_Overflow := TRUE
else }
{L001:}
$3B/$1E/Async_Buffer_Tail/ { CMP BX,Async_Buffer_Tail }
$75/$08/ { JNE L002 }
$C6/$06/Async_Buffer_Overflow/$01/ { MOV Async_Buffer_Overflow,1 }
$90/ { NOP generated by assembler for some reason }
$EB/$16/ { JMP SHORT L003 }
{ begin
Async_Buffer_Head := Async_Buffer_NewHead;
Async_Buffer_Used := Async_Buffer_Used + 1;
if Async_Buffer_Used > Async_MaxBufferUsed then
Async_MaxBufferUsed := Async_Buffer_Used
end; }
{L002:}
$89/$1E/Async_Buffer_Head/ { MOV Async_Buffer_Head,BX }
$FF/$06/Async_Buffer_Used/ { INC Async_Buffer_Used }
$8B/$1E/Async_Buffer_Used/ { MOV BX,Async_Buffer_Used }
$3B/$1E/Async_MaxBufferUsed/ { CMP BX,Async_MaxBufferUsed }
$7E/$04/ { JLE L003 }
$89/$1E/Async_MaxBufferUsed/ { MOV Async_MaxBufferUsed,BX }
{L003:}
{ disable interrupts }
$FA/ { CLI }
{ Port[$20] := $20; } { use non-specific EOI }
$B0/$20/ { MOV AL,20h }
$E6/$20 ) { OUT 20h,AL }
end; { Async_Isr }
{----------------------------------------------------------------------}
{ Async_Init }
{ Performs initialization. }
{----------------------------------------------------------------------}
procedure Async_Init;
begin
Async_Open_Flag := FALSE;
Async_Buffer_Overflow := FALSE;
Async_Buffer_Used := 0;
Async_MaxBufferUsed := 0;
end; { Async_Init }
{----------------------------------------------------------------------}
{ Async_Close }
{ Turn off the COM port interrupts. }
{ reset the interrupt system when UART interrupts no longer needed }
{----------------------------------------------------------------------}
procedure Async_Close;
var
i, m : Integer;
begin
if Async_Open_Flag then { disable the IRQ on the 8259 }
begin
Inline($FA); { disable interrupts }
i := Port[I8088_IMR]; { get the interrupt mask register }
m := 1 shl Async_Irq; { set mask to turn off interrupt }
Port[I8088_IMR] := i OR m;
{ disable the 8250 data ready interrupt }
Port[UART_IER + Async_Base] := 0;
{ disable OUT2 on the 8250 }
Port[UART_MCR + Async_Base] := 0;
Inline($FB); { enable interrupts }
{ restore old interrupt vector }
RestoreInterruptVector(Async_Irq + 8);
Async_Open_Flag := FALSE { so we know the port is closed }
end
end; { Async_Close }
{----------------------------------------------------------------------}
{ Async_Open(Port, Baud : Integer; }
{ Parity : Char; }
{ WordSize, StpBits : Integer) : Boolean }
{ Sets up interrupt vector, initialies the COM port for }
{ processing, sets pointers to the buffer. Returns FALSE if COM }
{ port not installed. }
{----------------------------------------------------------------------}
function Async_Open(ComPort : Integer;
BaudRate : Integer;
Parity : Char;
WordSize : Integer;
StopBits : Integer): boolean;
var
ComParm : Integer;
i, m : Integer;
begin
if Async_Open_Flag then Async_Close;
if ComPort = 2 then
begin
Async_Port := 2;
Async_Base := COM2_Base;
Async_Irq := COM2_Irq
end
else
begin
Async_Port := 1; { default to COM1 }
Async_Base := COM1_Base;
Async_Irq := COM1_Irq
end;
GetInterruptVector(Async_Irq + 8);
if (Port[UART_IIR + Async_Base] AND $00F8) <> 0
then
Async_Open := FALSE
else
begin
Async_Buffer_Head := 0;
Async_Buffer_Tail := 0;
Async_Buffer_Overflow := FALSE;
{ Build the ComParm for RS232_Init }
{ See Technical Reference Manual for description }
ComParm := $0000;
{ Set up the bits for the baud rate }
i := 0;
repeat
i := i + 1
until (Async_Baud_Table[i].Baud = BaudRate) OR (i = Async_Num_Bauds);
ComParm := ComParm OR Async_Baud_Table[i].Bits;
if Parity in ['E', 'e'] then ComParm := ComParm OR $0018
else if Parity in ['O', 'o'] then ComParm := ComParm OR $0008
else ComParm := ComParm OR $0000; { default to No parity }
if WordSize = 7
then ComParm := ComParm OR $0002
else ComParm := ComParm OR $0003; { default to 8 data bits }
if StopBits = 2
then ComParm := ComParm OR $0004
else ComParm := ComParm OR $0000; { default to 1 stop bit }
{ use the BIOS COM port initialization routine to save typing the code }
BIOS_RS232_Init(Async_Port - 1, ComParm);
DOS_Set_Intrpt(Async_Irq + 8, CSeg, Ofs(Async_Isr));
{ read the RBR and reset any possible pending error conditions }
{ first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }
Inline($FA); { disable interrupts }
Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] AND $7F;
{ read the Line Status Register to reset any errors it indicates }
i := Port[UART_LSR + Async_Base];
{ read the Receiver Buffer Register in case it contains a character }
i := Port[UART_RBR + Async_Base];
{ enable the irq on the 8259 controller }
i := Port[I8088_IMR]; { get the interrupt mask register }
m := (1 shl Async_Irq) XOR $00FF;
Port[I8088_IMR] := i AND m;
{ enable the data ready interrupt on the 8250 }
Port[UART_IER + Async_Base] := $01; { enable data ready interrupt }
{ enable OUT2 on 8250 }
i := Port[UART_MCR + Async_Base];
Port[UART_MCR + Async_Base] := i OR $08;
Inline($FB); { enable interrupts }
Async_Open_Flag := TRUE; { bug fix by Scott Herr }
Async_Open := TRUE;
end;
end; { Async_Open }
{----------------------------------------------------------------------}
{ Transmits the character. }
{----------------------------------------------------------------------}
procedure kam_out(C : char);
var
i, m, counter : Integer;
begin
Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and RTS }
{ wait for CTS }
counter := MaxInt;
while (counter <> 0) AND ((Port[UART_MSR + Async_Base] AND $10) = 0) do
counter := counter - 1;
{ wait for Transmit Hold Register Empty (THRE) }
if counter <> 0 then counter := MaxInt;
while (counter <> 0) AND ((Port[UART_LSR + Async_Base] AND $20) = 0) do
counter := counter - 1;
if counter <> 0 then
begin
{ send the character }
Inline($FA); { disable interrupts }
Port[UART_THR + Async_Base] := Ord(C);
Inline($FB) { enable interrupts }
end
else
begin
Async_close;
restore_entry_screen;
writeln('COM',xmt_port:1,' has timed out.');
writeln('Check KAM for power on and/or proper operation.');
halt;
end;
end;
{----------------------------------------------------------------------}
{ Remove Character From Interrupt Driven Buffer }
{----------------------------------------------------------------------}
function kam_in: char;
begin
Inline($FA); { disable interrupts }
kam_in := Async_Buffer[Async_Buffer_Tail];
Async_Buffer_Tail := (Async_Buffer_Tail + 1) AND Async_Buffer_Max;
Async_Buffer_Used := Async_Buffer_Used - 1;
Inline($FB); { enable interrupts }
end;
{----------------------------------------------------------------------}
{ If a character is available, returns TRUE }
{----------------------------------------------------------------------}
function char_ready:boolean;
begin
char_ready := (Async_Buffer_Head <> Async_Buffer_Tail);
{ if (Async_Buffer_Head = Async_Buffer_Tail)
then char_ready := FALSE
else char_ready := TRUE; }
end;
var _bufchr : char;
procedure clear_buffer;
begin
repeat
if char_ready then _bufchr := kam_in;
delay(10);
until NOT char_ready;
end;
procedure kam_cmd(s : msg_type);
var i : integer;
begin
for i := 1 to length(s) do
kam_out(s[i]);
end;
procedure kam_cmd_CR(s : msg_type);
begin
kam_cmd(s + #13);
end;
procedure xmt_mode;
begin
if mode in [CW,RTTY,ASCII] then
begin
xmt_ON := TRUE;
kam_cmd(^C'T');
clear_buffer;
case mode of
CW : ;
RTTY, ASCII : if xmt_on_delay > 0 then
delay(xmt_on_delay * 100);
end;
end;
end;
procedure cw_status;
var status_str : string[7];
i : integer;
begin
status_str := ' ';
repeat
for i := 1 to 6 do
status_str[i] := status_str[i + 1];
repeat until char_ready;
status_str[7] := kam_in;
until (status_str[1] = '-');
if (status_str[7] = '-') then
rcv_wpm := copy(status_str,5,2);
end;
procedure rcv_stat;
begin
if mode in [CW,RTTY,ASCII] then
begin
kam_cmd(^C'R');
case mode of
ASCII : clear_buffer;
RTTY : clear_buffer;
CW : cw_status;
end;
end;
end;
procedure rcv_mode;
begin
if mode in [CW,RTTY,ASCII] then
begin
xmt_ON := FALSE;
rcv_stat;
end;
end;
procedure set_rtty_baud;
begin
kam_cmd(^C'R');
kam_cmd(^C + chr(49+baud));
clear_buffer;
if xmt_ON then xmt_mode;
end;
procedure mod_rtty_invert;
begin
kam_cmd(^C'R');
kam_cmd(^C'I');
invert := NOT invert;
clear_buffer;
if xmt_ON then xmt_mode;
end;
procedure set_rtty_shift;
begin
kam_cmd(^C'R');
kam_cmd(^C'S');
clear_buffer;
if xmt_on then xmt_mode;
end;
procedure cw_mode;
begin
mode := CW;
kam_cmd_CR('E OFF');
kam_cmd_CR('XM ON');
clear_buffer;
kam_cmd_CR('CW ' + xmt_wpm);
cw_status;
state := receive;
end;
procedure kam_xmt_wpm;
begin
kam_cmd(^C'X');
clear_buffer;
cw_mode;
if xmt_ON then
kam_cmd(^C'T');
end;
procedure rtty_mode;
begin
baud := 0;
mode := RTTY;
kam_cmd_CR('E OFF');
kam_cmd_CR('XM ON');
kam_cmd_CR('MARK 2100');
kam_cmd_CR('SPACE 2300');
kam_cmd_CR('RB ' + baud_rate[baud] );
kam_cmd_CR('SH ' + rtty_shift[shift]);
kam_cmd_CR('INVERT OFF');
kam_cmd_CR('CRAdd ON');
kam_cmd_CR('LF ON');
kam_cmd_CR('DIDdle ON');
kam_cmd_CR('R');
state := receive;
end;
procedure ascii_mode;
begin
baud := 5;
mode := ASCII;
kam_cmd_CR('MARK 2100');
kam_cmd_CR('SPACE 2300');
kam_cmd_CR('ASCB ' + baud_rate[baud] );
kam_cmd_CR('INVERT OFF');
kam_cmd_CR('CRAdd ON');
kam_cmd_CR('LF ON');
kam_cmd_CR('A');
state := receive;
end;
procedure packet_mode;
begin
mode := PACKET;
kam_cmd_CR('MARK '+packet_mark);
kam_cmd_CR('SPACE '+packet_space);
kam_cmd_CR('E ON');
kam_cmd_CR(SW_VHF+'A');
band := VHF;
state := transceive;
end;
procedure HF_Packet;
begin
kam_cmd(^C);
kam_cmd_CR(SW_HF+'A');
band := HF;
end;
procedure VHF_Packet;
begin
kam_cmd(^C);
kam_cmd_CR(SW_VHF+'A');
band := VHF;
end;
procedure amtor_mode;
begin
mode := AMTOR;
state := transceive;
kam_cmd_CR('E ON');
kam_cmd_CR('A');
band := HF;
end;
procedure packet_connect;
begin
kam_cmd_CR('C ' + PKCall);
end;
procedure packet_disconnect;
begin
kam_cmd(^C);
kam_cmd_CR('D');
end;
procedure PacketID;
var i : integer;
begin
kam_cmd_CR(^C);
clear_buffer;
for i := 1 to 5 do
begin
kam_cmd_CR('I');
delay(2000);
end;
clear_buffer;
end;
procedure new_mode;
begin
clear_buffer;
case mode of
AMTOR, CW, RTTY, ASCII : kam_cmd(^C'X');
PACKET : kam_cmd_CR(^C'D');
end;
clear_buffer;
save_screen;
aux_color;
window(35,8,45,16);
clrscr;
writeln;
writeln(' 1> CW');
writeln(' 2> RTTY');
writeln(' 3> ASCII');
writeln(' 4> PACKET');
writeln(' 5> AMTOR');
writeln;
write (' select..');
repeat key := readkey until key in ['1'..'5'];
case key of
'1' : cw_mode;
'2' : rtty_mode;
'3' : ascii_mode;
'4' : packet_mode;
'5' : amtor_mode;
end;
window(1,1,80,25);
restore_screen;
end;
procedure init_interface;
begin
Async_Init;
if (Async_Open(xmt_port, kam_baud_rate, 'N', 8, 1) = FALSE) then
begin
restore_entry_screen;
Writeln('COM',xmt_port:1,' not installed.');
halt;
end;
writeln('Initializing KAM interface');
kam_cmd_CR('XOFF 0');
kam_cmd_CR('XON 0'); clear_buffer;
packet_mode;
end;
procedure reset_kam;
begin
case mode of
CW, RTTY, ASCII, AMTOR : kam_cmd(^C'X');
PACKET : begin
kam_cmd_CR('MARK 2100');
kam_cmd_CR('SPACE 2300');
kam_cmd_CR(SW_VHF+'A');
end;
end;
clear_buffer;
Async_close;
end;